home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / ab20 / unarced / datacomm / vltjr / rexx / fifobbs.rexx < prev    next >
OS/2 REXX Batch file  |  1995-03-17  |  31KB  |  1,222 lines
  1. /** FifoBBS.rexx
  2. *
  3. *   Test of fifo-handler. A small BBS. Really small...
  4. *
  5. *   This requires VLT or VLTjr version 5.028 or later, and
  6. *   Matt Dillon's Fifo.library and fifo-handler. Please
  7. *   install these files and mount fifo: before running this.
  8. *
  9. *   Usage: FifoBBS [local | remote]
  10. *
  11. *   FifoBBS, when invoked without arguments will run a fake BBS
  12. *   in the current CLI. When invoked with the "local" argument,
  13. *   it will run with a local VLT, bypassing the serial port.
  14. *   In neither of these cases will "UPLOAD" or "DOWNLOAD" work.
  15. *   When invoked with the "remote" argument, it will run as a
  16. *   real BBS, through the serial port.
  17. *
  18. *   The BBS installs itself almost completely. All you have to
  19. *   do is assign FifoBBS: or change the BBSdevice string later on
  20. *   to the location you want. You will also need to set up VLT
  21. *   for running with its pipes on. After starting the BBS for
  22. *   for the first time, you can log on as Sysop, password
  23. *   SYSOP. It will ask you to change your password. From that
  24. *   moment on, you're in business. People can register, the
  25. *   sysop can validate them. Once on the system, type help to
  26. *   find a list of commands.
  27. *
  28. *   Alpha 0.4 by W.G.J. Langeveld, 30 January 1991.
  29. *
  30. **/
  31.    parse arg action
  32. /*
  33. *   Allow no interruptions for secure operation
  34. */
  35.    SIGNAL ON BREAK_C
  36.    SIGNAL ON BREAK_D
  37.    SIGNAL ON BREAK_E
  38.    SIGNAL ON BREAK_F
  39.    SIGNAL ON ERROR
  40.    SIGNAL ON FAILURE
  41.    SIGNAL ON HALT
  42.    SIGNAL ON SYNTAX
  43. /*
  44. *   This one is really for debugging purposes:
  45. */
  46.    SIGNAL ON NOVALUE
  47.  
  48.    Options failat 300
  49.    SignalLabel = "Start"
  50. /*
  51. *   Trick: here are all the global variables we want accessible to all
  52. *   routines. Watch the way interpret is used in the Procedure definitions
  53. */
  54.    GLOBAL = "GLOBAL SignalLabel BBSdevice BBSusers BBSlistings"
  55.    GLOBAL = GLOBAL || " BBSgeneral BBSmail BBSadmin BBSsysmsg BBSprompt"
  56.    GLOBAL = GLOBAL || " Protocols. CurrentUser."
  57. /*
  58. *   Get the support library.
  59. */
  60.    check = addlib('rexxsupport.library', 0, -30, 0)
  61. /*
  62. *   BBS definitions
  63. */
  64.    BBSdevice   = "FifoBBS:"
  65.    BBSusers    = BBSdevice"users"
  66.    BBSlistings = BBSdevice"listings"
  67.    BBSgeneral  = BBSdevice"general"
  68.    BBSmail     = BBSdevice"mail"
  69.    BBSadmin    = BBSdevice"admin"
  70.    BBSsysmsg   = BBSdevice"admin/system.msg"
  71.    BBSprompt   = "FifoBBS> "
  72. /*
  73. *   Check if the sections exist, or else make them
  74. */
  75.    if ~exists(BBSdevice) then do
  76.       say "You must set up an assignment called "BBSdevice
  77.       exit 0
  78.    end
  79.    if ~exists(BBSusers)    then call Makedir(BBSusers)
  80.    if ~exists(BBSlistings) then call Makedir(BBSlistings)
  81.    if ~exists(BBSgeneral)  then call Makedir(BBSgeneral)
  82.    if ~exists(BBSmail)     then call Makedir(BBSmail)
  83.    if ~exists(BBSadmin)    then call Makedir(BBSadmin)
  84.    if ~exists(BBSsysmsg)   then address command "echo >"BBSsysmsg' "No news"'
  85. /*
  86. *   If there's no sysop account, make one
  87. */
  88.    if ~exists(BBSmail"/Sysop") then do
  89.       Tmp. = ""
  90.       Tmp.Account   = "Sysop"
  91.       Tmp.Password  = "SYSOP"
  92.       Tmp.Access    = 5
  93.       Tmp.Name      = "Sysop"
  94.       Tmp.MsgCount  = 0
  95.       Tmp.MailCount = 0
  96.       Tmp.Protocol  = 1
  97.       call SetRecord()
  98.       call Makedir(BBSmail"/Sysop")
  99.    end
  100. /*
  101. *   Transfer Protocols
  102. */
  103.    Protocols.0 = 5
  104.    Protocols.1.nam = "XMODEM"
  105.    Protocols.1.lib = "xprxmodem.library"
  106.    Protocols.1.set = "C1,K1"
  107.    Protocols.2.nam = "ZMODEM"
  108.    Protocols.2.lib = "xprzmodem.library"
  109.    Protocols.2.set = "T?,OS,B1,AN,DN,KN,SN,RN"
  110.    Protocols.3.nam = "Kermit"
  111.    Protocols.3.lib = "xprkermit.library"
  112.    Protocols.3.set = "OCY,GN,TN,P1500,B3"
  113.    Protocols.4.nam = "CIS QuickB"
  114.    Protocols.4.lib = "xprquickb.library"
  115.    Protocols.4.set = "TC,OS,B1,AN,DN,KN"
  116.    Protocols.5.nam = "ASCII"
  117.    Protocols.5.lib = "xprascii.library"
  118.    Protocols.5.set = "50"
  119. /*
  120. *   Redirect I/O to VLT's pipes
  121. *   For use as a BBS, use VLTR (remote). For local tests
  122. *   use VLTL (local).
  123. */
  124.    if action = "remote" then pip = "VLTR"
  125.    else                      pip = "VLTL"
  126. /*
  127. *   When action is not either "local" or "remote", you will run in
  128. *   the CLI (and you will see some echoes not otherwise present).
  129. */
  130.    if action ~= "" then do
  131.       call close("STDIN")
  132.       call close("STDOUT")
  133. /*
  134. *   First open fifo for read/write and assign to stdin
  135. */
  136.       if ~open("STDIN", "fifo:"pip"/rws") then do
  137.          say "Can't open read pipe"
  138.          exit 0
  139.       end
  140. /*
  141. *   Identify stdin with the "current console"
  142. */
  143.       call pragma('*', "STDIN")
  144. /*
  145. *   Open stdout to the current console for write.
  146. */
  147.       if ~open("STDOUT", '*', "W") then do
  148.          say "Can't open write pipe"
  149.          exit 0
  150.       end
  151.    end
  152.  
  153.  
  154.  
  155. /*
  156. *   Wait for <cr>. Here's where we go on severe problems.
  157. */
  158. Start:
  159.    s = GetCommand("", 0)
  160. /*
  161. *   Welcome message.
  162. */
  163.    say "+--------------------------------------------------+"
  164.    say "|  FifoBBS  -  Only authorized users are welcome!  +"
  165.    say "+--------------------------------------------------+"
  166. /*
  167. *   Log in. Don't let users without sufficient privilege get past here.
  168. */
  169.    CurrentUser. = ""
  170.    call Login()
  171.    if CurrentUser.Access < 3 then interpret "SIGNAL" SignalLabel
  172. /*
  173. *   If user is Sysop, make sure the password is changed first time
  174. */
  175.    if upper(CurrentUser.Account) = "SYSOP" then do
  176.       do while upper(CurrentUser.Password) = "SYSOP"
  177.          say "You MUST change the Sysop password now!"
  178.          call ChangePassword()
  179.       end
  180.    end
  181. /*
  182. *   System message
  183. */
  184.    if exists(BBSsysmsg) then address command "type "BBSsysmsg
  185. /*
  186. *   Unread mail
  187. */
  188.    n = GetMsgLeft(BBSmail"/"CurrentUser.Account, CurrentUser.MailCount)
  189.    if n ~= 0 then say "You have "n" unread mail message"Esses(n)
  190. /*
  191. *   Unread regular messages
  192. */
  193.    n = GetMsgLeft(BBSgeneral, CurrentUser.MsgCount)
  194.    if n ~= 0 then say "You have "n" unread general message"Esses(n)
  195. /*
  196. *   Main loop. Not too many commands yet. But you get the
  197. *   idea... Some commands are only available with level 5 clearance.
  198. */
  199.    do i = 1
  200.       s = GetCommand(BBSprompt, 1)
  201.       parse var s cmd arg1 arg2 .
  202.       cmd = upper(cmd)
  203.       select
  204.          when abbrev("DOWNLOAD", cmd, 2) then call Download(arg1)
  205.          when abbrev("ENTER",    cmd, 3) then call EnterMsg("")
  206.          when abbrev("EXIT",     cmd, 4) then call ExitBBS(cmd)
  207.          when abbrev("HELP",     cmd, 1) then call HelpList("")
  208.          when abbrev("LIST",     cmd, 2) then call ListFiles()
  209.          when abbrev("LOGOFF",   cmd, 2) then leave i
  210.          when abbrev("MAIL",     cmd, 2) then call DoMail()
  211.          when abbrev("PASSWORD", cmd, 3) then call ChangePassword()
  212.          when abbrev("PROTOCOL", cmd, 3) then call ChangeProtocol(arg1)
  213.          when abbrev("REGISTER", cmd, 3) then call Register(cmd)
  214.          when abbrev("READ",     cmd, 2) then call ReadMsg(arg1)
  215.          when abbrev("SHOW",     cmd, 2) then call ShowRecord(arg1)
  216.          when abbrev("SYSTEM",   cmd, 2) then call DoSystem(cmd)
  217.          when abbrev("UPLOAD",   cmd, 2) then call UpLoad(arg1)
  218.          when abbrev("USERS",    cmd, 2) then call ShowUsers()
  219.          when abbrev("VALIDATE", cmd, 1) then call Validate(cmd, arg1, arg2)
  220.          otherwise                            call HelpList(cmd)
  221.       end
  222.    end
  223.  
  224. /*
  225. *   Save message and mail count
  226. */
  227.    n = CurrentUser.MsgCount
  228.    m = CurrentUser.MailCount
  229.    Tmp.Account = CurrentUser.Account
  230.    call GetRecord()
  231.    Tmp.MsgCount  = n
  232.    Tmp.MailCount = m
  233.    call SetRecord()
  234. /*
  235. *   Logout
  236. */
  237.    say CurrentUser.Name" logged off at "time()
  238.    interpret "SIGNAL" SignalLabel
  239.  
  240.  
  241.  
  242. /**************************************************************/
  243. /**************** Functions ***********************************/
  244. /**************************************************************/
  245.  
  246. /**
  247. *
  248. *   Change the password
  249. *
  250. **/
  251. ChangePassword: interpret "Procedure Expose" GLOBAL
  252.    Tmp.Account = CurrentUser.Account
  253.  
  254.    if GetRecord() = 1 then do
  255.       t = upper(GetCommand("Old Password: ", 0))
  256.       if t ~= Tmp.Password then do
  257.          say "Invalid Password"
  258.          return
  259.       end
  260.       t = upper(GetCommand("New Password: ", 0))
  261.       u = upper(GetCommand("Verification: ", 0))
  262.       if u ~= t then do
  263.          say "Verification doesn't match new password, aborted"
  264.          return
  265.       end
  266.       else do
  267.          Tmp.Password         = u
  268.          CurrentUser.Password = u
  269.          call SetRecord()
  270.       end
  271.    end
  272.    return
  273.  
  274.  
  275.  
  276. /**
  277. *
  278. *   Change the transfer protocol
  279. *
  280. **/
  281. ChangeProtocol: interpret "Procedure Expose" GLOBAL
  282.    arg s
  283.  
  284.    if s = "" then do
  285.       say "Transfer Protocol:"
  286.  
  287.       do i = 1 to Protocols.0
  288.          say i". "Protocols.i.nam
  289.       end
  290.       i = CurrentUser.Protocol + 0
  291.       say "Your current protocol is "Protocols.i.nam
  292.    end
  293.  
  294.    Tmp.Account = CurrentUser.Account
  295.  
  296.    if GetRecord() = 1 then do
  297.       do i = 1
  298.          if s = "" then t = upper(GetCommand("Enter new protocol (1 - 5): ", 1))
  299.          else           t = s
  300.  
  301.          if (t ~= 1) & (t ~= 2) & (t ~= 3) & (t ~= 4) & (t ~= 5) then do
  302.             say "A number from 1 through 5 was expected"
  303.             s = ""
  304.             iterate i
  305.          end
  306.          leave i
  307.       end
  308.  
  309.       CurrentUser.Protocol = t
  310.       if s = "" then do
  311.          if GetYesNo("Save for next time? ") = 1 then do
  312.             Tmp.Protocol = t
  313.             call SetRecord()
  314.          end
  315.       end
  316.    end
  317.    return
  318.  
  319.  
  320.  
  321. /**
  322. *
  323. *   Collect a message
  324. *
  325. **/
  326. CollectMsg: interpret "Procedure Expose" GLOBAL "msg."
  327.    arg comm
  328.  
  329.    say "Enter the message below."
  330.    say "Enter a dot as the first character on a line to exit."
  331.  
  332.    if comm = "" then do
  333.       msg.3 = "Title: " || GetCommand("Title: ", 1)
  334.       ni = 4
  335.    end
  336.    else ni = 3
  337.  
  338.    do k = 1
  339.       do n = ni
  340.          msg.n = GetCommand(">", 1)
  341.          if substr(msg.n, 1, 1) = "." then leave n
  342.       end
  343.  
  344.       do i = 1
  345.          s = upper(GetCommand("Quit, Continue, List, Post: ", 1))
  346.          if      abbrev("QUIT",     s, 1) then return 0
  347.          else if abbrev("LIST",     s, 1) then do
  348.             do j = 3 to n - 1
  349.                say msg.j
  350.             end
  351.          end
  352.          else if abbrev("POST",     s, 1) then leave k
  353.          else if abbrev("CONTINUE", s, 1) then do
  354.             ni = n
  355.             leave i
  356.          end
  357.       end
  358.    end
  359.    return n - 1
  360.  
  361.  
  362. /**
  363. *
  364. *   Copy the user's record from Tmp.
  365. *
  366. **/
  367. CopyRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  368.    CurrentUser.Account   = Tmp.Account
  369.    CurrentUser.Password  = Tmp.Password
  370.    CurrentUser.Access    = Tmp.Access
  371.    CurrentUser.Name      = Tmp.Name
  372.    CurrentUser.City      = Tmp.City
  373.    CurrentUser.Country   = Tmp.Country
  374.    CurrentUser.Telephone = Tmp.Telephone
  375.    CurrentUser.MsgCount  = Tmp.MsgCount
  376.    CurrentUser.MailCount = Tmp.MailCount
  377.    CurrentUser.Protocol  = Tmp.Protocol
  378.  
  379.    return
  380.  
  381.  
  382. /**
  383. *
  384. *   Mail subsystem. Two commands: read and enter. They use the same
  385. *   basic functions as the main system, but with different paths.
  386. *
  387. **/
  388. DoMail: interpret "Procedure Expose" GLOBAL
  389.    do i = 1
  390.       s = upper(GetCommand("Mail: ", 1))
  391.       parse var s cmd arg1 .
  392.       select
  393.          when abbrev("TO",    cmd, 2) then call EnterMail("", arg1)
  394.          when abbrev("HELP",  cmd, 1) then call HelpLMail("")
  395.          when abbrev("QUIT",  cmd, 1) then leave i
  396.          when abbrev("READ",  cmd, 2) then call ReadMail(arg1)
  397.          when abbrev("SHOW",  cmd, 2) then call ShowRecord(arg1)
  398.          when abbrev("USERS", cmd, 2) then call ShowUsers()
  399.          otherwise                         call HelpLMail(cmd)
  400.       end
  401.    end
  402.    return
  403.  
  404.  
  405.  
  406. /**
  407. *
  408. *   Download an existing file
  409. *
  410. **/
  411. DownLoad : interpret "Procedure Expose" GLOBAL
  412.    parse arg filnam
  413.  
  414.    if filnam = "" then filnam = GetCommand("File name? ", 1)
  415.    if ~exists(BBSlistings"/"filnam) then do
  416.       say "Can't find file "filnam
  417.       return
  418.    end
  419.  
  420.    say "Get ready to receive file "filnam
  421.  
  422.    proto = CurrentUser.Protocol + 0
  423.    address VLT "transfer protocol external; transfer mode image"
  424.    address VLT "xpr select "Protocols.proto.lib
  425.    address VLT "CD "BBSlistings
  426.    if Protocols.proto.set ~= "" then address VLT "xpr init "Protocols.proto.set
  427.    address VLT "file send "BBSlistings"/"filnam
  428. /*
  429. *   Switch back to XMODEM protocol so that we can't automatically start
  430. *   receiving stuff.
  431. */
  432.    address VLT "transfer protocol XMODEM"
  433.    return
  434.  
  435.  
  436.  
  437. /**
  438. *
  439. *   More or less direct access to the system
  440. *
  441. **/
  442. DoSystem: interpret "Procedure Expose" GLOBAL
  443.    parse arg s
  444.    if CurrentUser.Access < 5 then do
  445.       call HelpList(s)
  446.       return
  447.    end
  448. /*
  449. *   In case a command breaks, this is the label we want to get
  450. *   back to.
  451. */
  452. SysCall: SignalLabel = "SysCall"
  453.    do i = 1
  454.       s = GetCommand("$ ", 1)
  455.       parse var s cmd rest
  456.       cmd = upper(cmd)
  457.       if abbrev("RETURN", cmd, 3) then do
  458.          leave i
  459.       end
  460.       else if (cmd = "CD") & (rest ~= "") then do
  461.          call pragma("Directory", strip(rest))
  462.       end
  463.       else do
  464.          address command s
  465.       end
  466.    end
  467. /*
  468. *   Change the label back to what it was.
  469. */
  470.    SignalLabel = "Start"
  471.    return
  472.  
  473.  
  474.  
  475. /**
  476. *
  477. *   Enter a new mail message.
  478. *
  479. **/
  480. EnterMail: interpret "Procedure Expose" GLOBAL
  481.    parse arg comm, dest
  482.  
  483.    if dest = "" then dest = GetCommand("To: ", 1)
  484.    Tmp.Account = dest
  485.    if GetRecord() ~= 1 then do
  486.       say "No such account"
  487.       return
  488.    end
  489.  
  490.    n = CollectMsg(comm)
  491.    if n = 0 then return
  492.  
  493.    call MakeFile(comm, BBSmail"/"CurrentUser.Account, n)
  494.    if Tmp.Account ~= CurrentUser.Account then do
  495.       call MakeFile(comm, BBSmail"/"Tmp.Account, n)
  496.    end
  497.    return
  498.  
  499.  
  500.  
  501. /**
  502. *
  503. *   Enter a new message. Someone should build in an editor...
  504. *
  505. **/
  506. EnterMsg : interpret "Procedure Expose" GLOBAL
  507.    parse arg comm
  508.  
  509.    n = CollectMsg(comm)
  510.    if n = 0 then return
  511.  
  512.    call MakeFile(comm, BBSgeneral, n)
  513.    return
  514.  
  515.  
  516.  
  517. /**
  518. *
  519. *   An s or not an s
  520. *
  521. **/
  522. Esses: interpret "Procedure Expose" GLOBAL
  523.    arg n
  524.    if n > 1 then return "s"
  525.    return ""
  526.  
  527.  
  528.  
  529. /**
  530. *
  531. *   Exit the BBS program
  532. *
  533. **/
  534. ExitBBS: interpret "Procedure Expose" GLOBAL
  535.    parse arg s
  536.    if CurrentUser.Access >= 5 then exit 0
  537.    else call HelpList(s)
  538.    return
  539.  
  540.  
  541.  
  542. /**
  543. *
  544. *   This gets the command from stdin. We can't use "pull"
  545. *   because it doesn't echo the way we open things (Fifo doesn't
  546. *   have a console handler) so we have to do it all ourselves (including
  547. *   echo and backspace). No command line editing yet.
  548. *   The first argument is the prompt string, the second argument
  549. *   specifies whether or not to echo what the user types.
  550. *   This routine checks for the presence of a "NO CARRIER"
  551. *   string at the end of the command line. If it is present, the
  552. *   session is aborted immediately. For this to work, you must make sure
  553. *   your modem detects carrier loss and sends this string.
  554. *
  555. **/
  556. GetCommand: interpret "Procedure Expose" GLOBAL
  557.    parse arg pr, echo
  558. /*
  559. *   Some constants
  560. */
  561.    cr = '0d'x
  562.    lf = '0a'x
  563.    bs = '08'x
  564.    crlf = cr||lf
  565.  
  566.    call writech("STDOUT", pr)
  567.  
  568.    command = ""
  569.  
  570.    do forever
  571. /*
  572. *   Read a character from STDIN
  573. */
  574.       s = readch("STDIN", 1)
  575. /*
  576. *   If we get an EOF condition, abort this session.
  577. */
  578.       if eof("STDIN") then SIGNAL "Start"
  579. /*
  580. *   Echo the character. Watch out for backspaces.
  581. */
  582.       if echo = 1 then do
  583.          if s ~= bs then call writech("STDOUT", s)
  584.          else if length(command) > 0 then call writech("STDOUT", bs" "bs)
  585.       end
  586. /*
  587. *   We have a <cr> of <lf>. This is the end of a command line.
  588. *   Echo a line feed to STDOUT. Check if the line ends in
  589. *   NO CARRIER. If so, abort the session. Else, return the command.
  590. */
  591.       if s = cr | s = lf then do
  592.          call writech("STDOUT", lf)
  593.  
  594.          nc = index(command, "NO CARRIER")
  595.          if nc ~= 0 then do
  596.             if nc = length(command) - 9 then do
  597.                say "NO CARRIER detected, aborting session"
  598.                SIGNAL "Start"
  599.             end
  600.          end
  601.  
  602.          return command
  603.       end
  604. /*
  605. *   It's a backspace. Take off the last character of the command.
  606. */
  607.       else if s = bs then do
  608.          l = length(command)
  609.          if l > 0 then command = substr(command, 1, l - 1)
  610.       end
  611. /*
  612. *   A regular character. Add it to the command
  613. */
  614.       else command = command || s
  615.    end
  616.    return
  617.  
  618.  
  619.  
  620. /**
  621. *
  622. *   Get highest numbered message in the source directory
  623. *
  624. **/
  625. GetHighMsg: interpret "Procedure Expose" GLOBAL
  626.    parse arg source
  627.  
  628.    files = showdir(source, "FILES")
  629. /*
  630. *   Loop over the files, and get the highest unread  message number
  631. */
  632.    high = 0
  633.    do i = 1
  634.       parse var files "msg."k files
  635.       if k > high then high = k
  636.       if files = "" then leave
  637.    end
  638.    return high
  639.  
  640.  
  641.  
  642. /**
  643. *
  644. *   Get number of messages left to read.
  645. *
  646. **/
  647. GetMsgLeft: interpret "Procedure Expose" GLOBAL
  648.    parse arg source, last
  649.  
  650.    files = showdir(source, "FILES")
  651. /*
  652. *   Loop over the files, and extract number of messages left to read (n)
  653. */
  654.    n = 0
  655.    do i = 1
  656.       parse var files "msg."k files
  657.       if k > last then n = n + 1
  658.       if files = "" then leave
  659.    end
  660.    return n
  661.  
  662.  
  663.  
  664.  
  665. /**
  666. *
  667. *   Retrieve a user's record
  668. *
  669. **/
  670. GetRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  671.    succ = 0
  672.    if open("fi", BBSusers"/"Tmp.Account) then do
  673.       t = readln("fi")
  674.       if t ~= "" then do
  675.          parse var t Tmp.Password  '|' Tmp.Access   '|' ,
  676.                      Tmp.Name      '|' Tmp.Address  '|' ,
  677.                      Tmp.City      '|' Tmp.Country  '|' ,
  678.                      Tmp.Telephone '|' Tmp.MsgCount '|' ,
  679.                      Tmp.MailCount '|' Tmp.Protocol '|'
  680.          succ = 1
  681.       end
  682.       call close("fi")
  683.    end
  684.    return succ
  685.  
  686.  
  687.  
  688. /**
  689. *
  690. *   This gets a yes/no decision from stdin
  691. *   The single argument is used as the prompt.
  692. *
  693. **/
  694. GetYesNo: interpret "Procedure Expose" GLOBAL
  695.    parse arg prompt
  696.  
  697.    do i = 1
  698.       ss = upper(GetCommand(prompt" [Yes/No]: ", 1))
  699.       if      substr(ss, 1, 1) = 'Y' then return 1
  700.       else if substr(ss, 1, 1) = 'N' then return 0
  701.       else do
  702.          say "A Yes or No was expected, retry"
  703.       end
  704.    end
  705.    return
  706.  
  707.  
  708.  
  709. /**
  710. *
  711. *   List supported commands. Can be as extensive as you want.
  712. *
  713. **/
  714. HelpList: interpret "Procedure Expose" GLOBAL
  715.    parse arg s
  716.  
  717.    if s ~= "" then say "Unknown command: "s
  718.  
  719.    Say "Supported commands are: "
  720.    Say "-------------------------+-------------------------------------"
  721.    Say "DOWNLOAD [filename]      | Download a file [called filename]"
  722.    Say "ENTER                    | Enter a message"
  723.  
  724.    if CurrentUser.Access >= 5 then
  725.    Say "*EXIT                    | Exit the BBS program"
  726.  
  727.    Say "HELP                     | Display this list"
  728.    Say "LIST                     | List downloadable files"
  729.    Say "LOGOFF                   | Logoff"
  730.    Say "MAIL                     | Go to mail subsytem"
  731.    Say "PASSWORD                 | Set new password"
  732.    Say "PROTOCOL [n]             | Set new transfer protocol [to n]"
  733.    Say "READ [message]           | Read messages [starting at message]"
  734.  
  735.    if CurrentUser.Access >= 5 then
  736.    Say "*REGISTER                | Add a new user to the system"
  737.  
  738.    Say "SHOW [name]              | Show current record [of user ""name""]"
  739.  
  740.    if CurrentUser.Access >= 5 then
  741.    Say "*SYSTEM                  | Change to system command level"
  742.  
  743.    Say "UPLOAD [filename]        | Upload a file [called filename]"
  744.    Say "USERS                    | Show the user list"
  745.  
  746.    if CurrentUser.Access >= 5 then
  747.    Say "*VALIDATE [user] [level] | Validate a new user"
  748.    Say "-------------------------+-------------------------------------"
  749.    return
  750.  
  751.  
  752.  
  753. /**
  754. *
  755. *   List supported commands in mail.
  756. *
  757. **/
  758. HelpLMail: interpret "Procedure Expose" GLOBAL
  759.    parse arg s
  760.  
  761.    if s ~= "" then say "Unknown command: "s
  762.  
  763.    Say "Supported commands while in mail are: "
  764.    Say "----------------+-------------------------------------"
  765.    Say "TO              | Enter a message"
  766.    Say "HELP            | Display this list"
  767.    Say "QUIT            | Quit from the mail subsystem"
  768.    Say "READ [message]  | Read messages [starting at message]"
  769.    Say "SHOW [name]     | Show current record [of user ""name""]"
  770.    Say "USERS           | Show the user list"
  771.    Say "----------------+-------------------------------------"
  772.    return
  773.  
  774.  
  775.  
  776. /**
  777. *
  778. *   List downloadable files
  779. *
  780. **/
  781. ListFiles: interpret "Procedure Expose" GLOBAL
  782.    address command "list "BBSlistings" nohead"
  783.    return
  784.  
  785.  
  786.  
  787. /**
  788. *
  789. *   Handle logins and new registrations.
  790. *   Argument is a user account name, so we can log ourselves back in
  791. *   if we as a sysop have added someone else using Register().
  792. *
  793. **/
  794. Login: interpret "Procedure Expose" GLOBAL
  795.    Tmp.               = ""
  796.    Tmp.Access         = 0
  797.    CurrentUser.Access = 0
  798.  
  799.    Tmp.Account = upper(GetCommand("Username: ", 1))
  800.    if Tmp.Account = "NEW" then do
  801.       call Register("")
  802.       return
  803.    end
  804.    else if GetRecord() = 0 then do
  805.       say "Not registered."
  806.       say "To register, use the NEW account."
  807.    end
  808.    else do
  809.       s = upper(GetCommand("Password: ", 0))
  810.       if s ~= Tmp.Password then do
  811.          say "Unauthorized."
  812.          say "Bye now..."
  813.          Tmp.Access = 0
  814.       end
  815.    end
  816.  
  817.    call CopyRecord()
  818.    if CurrentUser.Access = 2 then say "You are not yet validated"
  819.    return
  820.  
  821.  
  822.  
  823. /**
  824. *
  825. *   Make a file header, and add it in the destination directory
  826. *
  827. **/
  828. MakeFile: interpret "Procedure Expose" GLOBAL "msg."
  829.    parse arg comm, dest, nlins
  830. /*
  831. *   Get list of files.
  832. */
  833.    files = showdir(dest, "FILES")
  834. /*
  835. *   Loop over the files, extract the highest message number and add
  836. *   1 for the current message.
  837. */
  838.    high = 0
  839.    do i = 1
  840.       parse var files "msg."k files
  841.       if k > high then high = k
  842.       if files = "" then leave
  843.    end
  844.    high = high + 1
  845. /*
  846. *   Header
  847. */
  848.    msg.0 = "=========="
  849.    msg.1 = "# "high", "date()", "time()", from "CurrentUser.Account". "
  850.    if comm ~= "" then msg.1 = msg.1 || "Comment to "comm"."
  851.    msg.2 = "----------"
  852.  
  853.    if ~open("fo", dest"/msg."high, "W") then do
  854.       say "Cannot add a message right now"
  855.       return
  856.    end
  857.  
  858.    do i = 0 to nlins
  859.       call writeln("fo", msg.i)
  860.    end
  861.  
  862.    call close("fo")
  863.    return
  864.  
  865.  
  866.  
  867. /**
  868. *
  869. *   Read mail messages.
  870. *   One argument: the message number to start reading. This resets the
  871. *   message pointer. This also allows you to skip to the last.
  872. *
  873. **/
  874. ReadMail: interpret "Procedure Expose" GLOBAL
  875.    parse arg nm
  876. /*
  877. *   If we have a message number for argument set user's message pointer
  878. *   to just before that.
  879. */
  880.    if nm ~= "" then CurrentUser.MailCount = nm - 1
  881. /*
  882. *   Unread mail
  883. */
  884.    source = BBSmail"/"CurrentUser.Account
  885.  
  886.    n = GetMsgLeft(source, CurrentUser.MailCount)
  887.    if n ~= 0 then say "You have "n" unread mail message"Esses(n)
  888.    else           CurrentUser.MailCount = GetHighMsg(source)
  889. /*
  890. *   Message read loop
  891. */
  892.    do i = 1 to n
  893.       do k = CurrentUser.MailCount + 1
  894.          if ~exists(source"/msg."k) then iterate k
  895.          address command "type "source"/msg."k
  896.          CurrentUser.MailCount = k
  897.  
  898.          do j = 1
  899.             s = upper(GetCommand("[Quit, Again, Delete, Reply, Next = <cr>]: ", 1))
  900.             if      abbrev("QUIT",   s, 1) then return
  901.             else if abbrev("AGAIN",  s, 1) then do
  902.                CurrentUser.MailCount = k - 1
  903.                i = i - 1
  904.             end
  905.             else if abbrev("DELETE", s, 1) then do
  906.                call Delete(source"/msg."k)
  907.                say "Deleted"
  908.                CurrentUser.MailCount = k - 1
  909.             end
  910.             else if abbrev("REPLY",  s, 1) then do
  911.                if open("fi", source"/msg."k) then do
  912.                   call readln("fi")
  913.                   t = readln("fi")
  914.                   parse var t dummy "from " owner ". " rest
  915.                   call close("fi")
  916.                   call EnterMail(k, owner)
  917.                end
  918.             end
  919.             else if abbrev("NEXT",   s, 1) then nop
  920.             else if s = ""                 then nop
  921.             else iterate j
  922.             iterate i
  923.          end
  924.       end
  925.    end
  926.    say "No more unread messages"
  927.    return
  928.  
  929.  
  930.  
  931. /**
  932. *
  933. *   Read messages.
  934. *   Two arguments: (1) the message number to start reading. This resets the
  935. *   message pointer. This also allows you to skip to the last. (2) The
  936. *   source directory to read from.
  937. *
  938. **/
  939. ReadMsg : interpret "Procedure Expose" GLOBAL
  940.    parse arg nm
  941. /*
  942. *   If we have a message number for argument set user's message pointer
  943. *   to just before that.
  944. */
  945.    if nm ~= "" then CurrentUser.MsgCount = nm - 1
  946. /*
  947. *   Unread regular messages
  948. */
  949.    source = BBSgeneral
  950.  
  951.    n = GetMsgLeft(source, CurrentUser.MsgCount)
  952.    if n ~= 0 then say "You have "n" unread general message"Esses(n)
  953.    else           CurrentUser.MsgCount = GetHighMsg(source)
  954. /*
  955. *   Message read loop
  956. */
  957.    do i = 1 to n
  958.       do k = CurrentUser.MsgCount + 1
  959.          if ~exists(source"/msg."k) then iterate k
  960.          address command "type "source"/msg."k
  961.          CurrentUser.MsgCount = k
  962.  
  963.          do j = 1
  964.             s = upper(GetCommand("[Quit, Again, Delete, Comment, Next = <cr>]: ", 1))
  965.  
  966.             if      abbrev("QUIT",    s, 1) then return
  967.             else if abbrev("AGAIN",   s, 1) then do
  968.                CurrentUser.MsgCount = k - 1
  969.                i = i - 1
  970.             end
  971.             else if abbrev("DELETE",  s, 1) then do
  972.                if open("fi", source"/msg."k) then do
  973.                   call readln("fi")
  974.                   t = readln("fi")
  975.                   parse var t dummy "from " owner ". " rest
  976.                   call close("fi")
  977.                   if owner = CurrentUser.Account then do
  978.                      call Delete(source"/msg."k)
  979.                      say "Deleted"
  980.                   end
  981.                   else do
  982.                      say "You didn't write this message"
  983.                      if CurrentUser.Access >= 5 then do
  984.                         if GetYesNo("Withdraw anyway? ") = 1 then do
  985.                            call Delete(source"/msg."k)
  986.                            say "Deleted"
  987.                         end
  988.                      end
  989.                   end
  990.                end
  991.             end
  992.             else if abbrev("COMMENT", s, 1) then call EnterMsg(k, source)
  993.             else if abbrev("NEXT",    s, 1) then nop
  994.             else if s = ""                  then nop
  995.             else                                 iterate j
  996.             iterate i
  997.          end
  998.       end
  999.    end
  1000.    say "No more unread messages"
  1001.    return
  1002.  
  1003.  
  1004.  
  1005. /**
  1006. *
  1007. *   Register a new user. The new user is immediately added to the
  1008. *   system, but his access code is 2 which doesn't allow her to
  1009. *   log in yet. The Sysop uses the Validate command to set the access
  1010. *   code to a higher level. 3 is suggested... 5 gives system privileges.
  1011. *
  1012. **/
  1013. Register: interpret "Procedure Expose" GLOBAL
  1014.    parse arg s
  1015. /*
  1016. *   If access = 0 this is a new user. If access = 5, this is called by
  1017. *   the Sysop.
  1018. */
  1019.    if CurrentUser.Access = 0 then prefix = "Your "
  1020.    else if CurrentUser.Access < 5 then do
  1021.       call HelpList(s)
  1022.       return
  1023.    end
  1024.    else prefix = "New "
  1025. /*
  1026. *   Generate registration record
  1027. */
  1028.    Tmp.Account   =       GetCommand(prefix"account name:         ", 1)
  1029.    if GetRecord() = 1 then do
  1030.       say "Account name already taken"
  1031.       return
  1032.    end
  1033.    Tmp.Password  = upper(GetCommand(prefix"password:             ", 0))
  1034.    Tmp.Name      =       GetCommand(prefix"full name:            ", 1)
  1035.    Tmp.Address   =       GetCommand(prefix"address:              ", 1)
  1036.    Tmp.City      =       GetCommand(prefix"city, zip:            ", 1)
  1037.    Tmp.Country   =       GetCommand(prefix"country and/or state: ", 1)
  1038.    Tmp.Telephone =       GetCommand(prefix"telephone number:     ", 1)
  1039.    Tmp.Protocol  = 1
  1040.    Tmp.Access    = 2
  1041.    Tmp.MsgCount  = 0
  1042.    Tmp.MailCount = 0
  1043.  
  1044.    say "You are:"
  1045.    say Tmp.Name
  1046.    say Tmp.Address
  1047.    say Tmp.City
  1048.    say Tmp.Country
  1049.    say Tmp.Telephone
  1050.  
  1051.    if GetYesNo("Correct? ") = 1 then do
  1052.       call SetRecord()
  1053.  
  1054.       if CurrentUser.Access = 0 then do
  1055.          say "Please give the Sysop a chance to validate you (usually < 24 hours)."
  1056.          say "Thank you for registering with this BBS."
  1057.       end
  1058.    end
  1059.    return
  1060.  
  1061.  
  1062.  
  1063. /**
  1064. *
  1065. *   Change a user's record
  1066. *
  1067. **/
  1068. SetRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  1069.    if Tmp.Access ~= 0 then do
  1070.       t = Tmp.Password  || '|' || Tmp.Access   || '|' ||,
  1071.           Tmp.Name      || '|' || Tmp.Address  || '|' ||,
  1072.           Tmp.City      || '|' || Tmp.Country  || '|' ||,
  1073.           Tmp.Telephone || '|' || Tmp.MsgCount || '|' ||,
  1074.           Tmp.MailCount || '|' || Tmp.Protocol || '|'
  1075.       if open("fo", BBSusers"/"Tmp.Account, "W") then do
  1076.          call writeln("fo", t)
  1077.          call close("fo")
  1078.       end
  1079.    end
  1080.    else call Delete(BBSusers'/'Tmp.Account)
  1081.    return
  1082.  
  1083.  
  1084.  
  1085. /**
  1086. *
  1087. *   Show a user's stats.
  1088. *
  1089. **/
  1090. ShowRecord: interpret "Procedure Expose" GLOBAL
  1091.    arg username
  1092.  
  1093.    if username = "" then Tmp.Account = CurrentUser.Account
  1094.    else                  Tmp.Account = username
  1095.    if GetRecord() = 1 then do
  1096.       say "Account info for "Tmp.Account":"
  1097.       say Tmp.Name
  1098.       say Tmp.Address
  1099.       say Tmp.City
  1100.       say Tmp.Country
  1101.       say Tmp.Telephone
  1102. /*
  1103. *   If asking about another user, don't need to show protocol.
  1104. *   If asking about ourselves, then show current protocol, not "saved" one.
  1105. */
  1106.       if username = "" then do
  1107.          i = CurrentUser.Protocol + 0
  1108.          say "Transfer protocol: "Protocols.i.nam
  1109.       end
  1110.    end
  1111.    else say "User "username" not found"
  1112.    return
  1113.  
  1114.  
  1115.  
  1116. /**
  1117. *
  1118. *   List files
  1119. *
  1120. **/
  1121. ShowUsers: interpret "Procedure Expose" GLOBAL
  1122.    address command "list "BBSusers" nohead quick"
  1123.    return
  1124.  
  1125.  
  1126.  
  1127. /**
  1128. *
  1129. *   Upload a new file
  1130. *
  1131. **/
  1132. UpLoad : interpret "Procedure Expose" GLOBAL
  1133.    parse arg filnam
  1134.  
  1135.    if filnam = "" then filnam = GetCommand("File name? ", 1)
  1136.    if exists(BBSlistings"/"filnam) then do
  1137.       say filnam" already exists!"
  1138.       return
  1139.    end
  1140.  
  1141.    say "Now send file "filnam
  1142.  
  1143.    proto = CurrentUser.Protocol + 0
  1144.    address VLT "transfer protocol external; transfer mode image"
  1145.    address VLT "xpr select "Protocols.proto.lib
  1146.    address VLT "CD "BBSlistings
  1147.    if Protocols.proto.set ~= "" then address VLT "xpr init "Protocols.proto.set
  1148.    address VLT "file receive "BBSlistings"/"filnam
  1149. /*
  1150. *   Switch back to XMODEM protocol so that we can't automatically start
  1151. *   receiving stuff.
  1152. */
  1153.    address VLT "transfer protocol XMODEM"
  1154.  
  1155.    return
  1156.  
  1157.  
  1158.  
  1159. /**
  1160. *
  1161. *   Routine to validate FifoBBS users. Only callable by the Sysop.
  1162. *
  1163. **/
  1164. Validate: interpret "Procedure Expose" GLOBAL
  1165.    parse arg s, nam, acc .
  1166.  
  1167.    if CurrentUser.Access < 5 then do
  1168.       call HelpList(s)
  1169.       return
  1170.    end
  1171.  
  1172.    if nam = "" then Tmp.Account = GetCommand("Name: ", 1)
  1173.    else             Tmp.Account = nam
  1174.  
  1175.    if GetRecord() = 0 then do
  1176.       say "Unknown account"
  1177.       return
  1178.    end
  1179.  
  1180.    if ~exists(BBSmail"/"Tmp.Account) then call Makedir(BBSmail"/"Tmp.Account)
  1181.  
  1182.    if acc = "" then do
  1183.       say "Account info for "Tmp.Account":"
  1184.       say Tmp.Name
  1185.       say Tmp.Address
  1186.       say Tmp.City
  1187.       say Tmp.Country
  1188.       say Tmp.Telephone
  1189.       say "Transfer protocol: "Tmp.Protocol
  1190.       say "Access code:       "Tmp.Access
  1191.  
  1192.       if GetYesNo("Change access code? ") = 1 then do
  1193.          Tmp.Access = GetCommand("Enter new access code: ", 1)
  1194.          call SetRecord()
  1195.       end
  1196.    end
  1197.    else do
  1198.       Tmp.Access = acc
  1199.       call SetRecord()
  1200.    end
  1201.    return
  1202.  
  1203.  
  1204.  
  1205.  
  1206.  
  1207. BREAK_C:
  1208. BREAK_D:
  1209. BREAK_E:
  1210. BREAK_F:
  1211. ERROR:
  1212. FAILURE:
  1213. HALT:
  1214. IOERROR:
  1215. NOVALUE:
  1216. SYNTAX:
  1217.    say "Command returned with error"
  1218.  
  1219.    interpret "SIGNAL" SignalLabel
  1220.  
  1221.    exit 0
  1222.